Trabalho Final - Conceitos Estatisticos para IA
Reconhecimento da base
Verificação das amostras e variáveis
## 'data.frame': 6497 obs. of 13 variables:
## $ fixedacidity : num 6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
## $ volatileacidity : num 0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
## $ citricacid : num 0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
## $ residualsugar : num 7.7 1.6 2.2 4.8 18.8 ...
## $ chlorides : num 0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
## $ freesulfurdioxide : num 36 29 18 30 65 16 4 34 46 58 ...
## $ totalsulfurdioxide: num 135 114 40 113 224 49 8 102 113 184 ...
## $ density : num 0.994 0.99 0.998 0.994 1 ...
## $ pH : num 3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
## $ sulphates : num 0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
## $ alcohol : num 10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
## $ quality : int 5 6 6 6 5 5 4 6 7 6 ...
## $ Vinho : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...A base possui 6497 amostras com as seguintes variáveis:
Fixed Acidity: Acidez contida no vinho
Volatile Acidity: Quantidade de ácido acético no vinho, valores altos podem levar o vinho a ter sabor desagradável de vinagre
Citric Acid: Encontrado em pouca quantidade, o ácido cítrico pode adicionar frescor e sabor ao vinho.
Residual Sugar: Quantidade de açucar restante após o término da fermentação. É raro encontrar vinhos com menos de 1 g/l e vinhos com valores maiores que 45 g/l são considerardos doces.
Chlorides: Quantidade de sal no vinho
Free Sulfur Dioxide: A forma livre de SO2 (dióxido de enxofre) existe em equilibrio entre SO2 molecular (como um gás dissolvido) e ions bissulfito. Evita o crescimento de micróbios e oxidação do vinho.
Total Sulfur Dioxide: Total de SO2 livres ou ligados. Em baixa concentração, o SO2 é praticamente imperceptível no vinho, mas em concentrações acima de 50 ppm, o dióxido de enxofre torna-se evidente no aroma e sabor do vinho
Density: A densidade do vinho depende do percentual de álcool e açúcar.
pH: Descreve se o vinho é básico (14) ou ácido (0). A maioria dos vinhos possuem pH entre 3 e 4
Sulphates: Aditivo que pode contribuir com os níveis de SO2, que age contra micróbios e oxidação
Alcohol: O percentual de álcool no vinho
Quality: Qualidade do vinho com pontuação de 0 a 10, sendo 10 muito bom e 0 de péssima qualidade
Vinho: Tipo do vinho: tinto (RED) ou branco (WHITE)
Sumário dos dados
## fixedacidity volatileacidity citricacid residualsugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.60
## 1st Qu.: 6.400 1st Qu.:0.2300 1st Qu.:0.2500 1st Qu.: 1.80
## Median : 7.000 Median :0.2900 Median :0.3100 Median : 3.00
## Mean : 7.215 Mean :0.3397 Mean :0.3186 Mean : 5.44
## 3rd Qu.: 7.700 3rd Qu.:0.4000 3rd Qu.:0.3900 3rd Qu.: 8.10
## Max. :15.900 Max. :1.5800 Max. :1.6600 Max. :45.80
## chlorides freesulfurdioxide totalsulfurdioxide density
## Min. :0.00900 Min. : 1.00 Min. : 6.0 Min. :0.9871
## 1st Qu.:0.03800 1st Qu.: 17.00 1st Qu.: 77.0 1st Qu.:0.9923
## Median :0.04700 Median : 29.00 Median :118.0 Median :0.9949
## Mean :0.05603 Mean : 30.53 Mean :115.7 Mean :0.9947
## 3rd Qu.:0.06500 3rd Qu.: 41.00 3rd Qu.:156.0 3rd Qu.:0.9970
## Max. :0.61100 Max. :289.00 Max. :440.0 Max. :1.0140
## pH sulphates alcohol quality
## Min. :2.720 Min. :0.2200 Min. : 0.9567 Min. :3.000
## 1st Qu.:3.110 1st Qu.:0.4300 1st Qu.: 9.5000 1st Qu.:5.000
## Median :3.210 Median :0.5100 Median :10.3000 Median :6.000
## Mean :3.219 Mean :0.5313 Mean :10.4862 Mean :5.818
## 3rd Qu.:3.320 3rd Qu.:0.6000 3rd Qu.:11.3000 3rd Qu.:6.000
## Max. :4.010 Max. :2.0000 Max. :14.9000 Max. :9.000
## Vinho
## RED :1599
## WHITE:4898
##
##
##
## Analisando o sumário, nota-se potenciais outliers dados que os valores mínimos e máximos estão muito distantes dos quartis para as seguintes variáveis: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, sulphates e alcohol
Além disso, há valores muito discrepantes:
Citric Acid com valor mínimo 0
Total Sulfur Dioxide com valor mínimo 6
Alcohol com valor mínimo 0,9667
Frequencia Absoluta
##
## RED WHITE
## 3 10 20
## 4 53 163
## 5 681 1457
## 6 638 2198
## 7 199 880
## 8 18 175
## 9 0 5Analisando a quantidade de vinhos por tipo e por qualidade, há mais vinhos do tipo branco do que tinto no data set. Também nota-se que ambos vinhos seguem uma tendência normal com relação à qualidade.
Valores estatisticos relevantes para o vinho tinto
Valores estatisticos relevantes para o vinho branco
Razão entre as estatísticas do vinho tinto para o vinho branco
Comparando-se os atributos dos vinhos tintos com os vinhos brancos de forma tabular através da observação dos parâmetros de máximo, mínimo, média, desvio padrão e mediana da amostra. Temos:
- Quase todos os atributos dos vinhos tem distribuição bem diferentes.
- Alguns poucos são semelhantes, pode-se citar: density, pH e quality
- Outros são muito desiguais: residualsugar,freesulfurdioxide,totalsulfurdioxide
- Para as outras características há diferenças significativas nos parâmetros entre 20% a quase 500%
Antes de qualquer conclusão, deve-se tratar as questões do outliers e valores faltantes que podem estar influenciando esta amostra.
Análise do açucar residual nos vinhos
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 6497
##
##
## | Vinhos$Vinho
## Vinhos$fx_redSugar | RED | WHITE | Row Total |
## -------------------|-----------|-----------|-----------|
## (0,10] | 1588 | 3705 | 5293 |
## | 62.493 | 20.401 | |
## | 0.300 | 0.700 | 0.815 |
## | 0.993 | 0.756 | |
## | 0.244 | 0.570 | |
## -------------------|-----------|-----------|-----------|
## (10,20] | 11 | 1175 | 1186 |
## | 270.305 | 88.244 | |
## | 0.009 | 0.991 | 0.183 |
## | 0.007 | 0.240 | |
## | 0.002 | 0.181 | |
## -------------------|-----------|-----------|-----------|
## (20,30] | 0 | 15 | 15 |
## | 3.692 | 1.205 | |
## | 0.000 | 1.000 | 0.002 |
## | 0.000 | 0.003 | |
## | 0.000 | 0.002 | |
## -------------------|-----------|-----------|-----------|
## (30,45.8] | 0 | 3 | 3 |
## | 0.738 | 0.241 | |
## | 0.000 | 1.000 | 0.000 |
## | 0.000 | 0.001 | |
## | 0.000 | 0.000 | |
## -------------------|-----------|-----------|-----------|
## Column Total | 1599 | 4898 | 6497 |
## | 0.246 | 0.754 | |
## -------------------|-----------|-----------|-----------|
##
## Através da análise acima, pode-se verificar que que a quantidade de açúcar restante nos vinhos tintos é muito menor, sendo que 99,3% destes vinhos tem até 10 g/l e apenas 0,7% possuem quantidade até 20g/l. No caso dos vinhos brancos, percebe-se 75,6% possuem até 10g/l de quantidade de açúcar restante, 24% até 20g/l, 0,3% até 30g/l e 0,1% até 45.8g/l
Por esta tabela, pode-se deduzir que os vinhos brancos são normalmente percebidos como mais doces que os vinhos tintos.
Análise Exploratória dos Dados
Retmoção de valores nulos ou zerados
Pelos resultados observados de forma tabular, temos que apenas o atributo citricacid possui valores zerados.
Abaixo são listados as amostras com ácido cítrico zerado:
## [1] 7 17 29 32 35 55 74 155 182 189 235 284 295 308
## [15] 328 336 436 470 618 628 824 882 884 918 979 1012 1061 1079
## [29] 1141 1187 1212 1222 1237 1244 1425 1608 1699 1700 1757 1812 1834 1836
## [43] 1850 1875 1895 1898 1906 1956 2239 2315 2402 2442 2451 2471 2489 2566
## [57] 2578 2652 2668 2724 2843 2878 2902 2906 2921 2966 3002 3078 3117 3220
## [71] 3261 3262 3300 3322 3441 3456 3469 3481 3507 3508 3596 3744 3799 3847
## [85] 3940 3973 3980 4036 4071 4129 4152 4200 4208 4216 4272 4282 4289 4321
## [99] 4394 4397 4512 4517 4534 4547 4549 4604 4704 4712 4768 4769 4814 4864
## [113] 4884 4947 4980 5048 5063 5079 5088 5108 5198 5301 5368 5389 5395 5406
## [127] 5432 5468 5497 5518 5538 5552 5594 5634 5651 5752 5778 5800 5813 5861
## [141] 5881 6013 6029 6077 6109 6256 6309 6394 6436 6451 6458Conforme pesquisado na Internet (https://vinosdiferentes.com/pt/acidez-do-vinho/) , sabemos que o valor do ácido cítrico deve variar entre 0.1 e 1. Deste modo, muito provavelmente, o valor zerado deve ocorrer por imprecisão dos aparelhos de medição da concentração de ácido cítrico. Fazemos a sua substituição pelo valor mínimo (0.1)
#Segundo o site https://vinosdiferentes.com/pt/acidez-do-vinho/
#O valor do ácido cítrico é bem baixo, entre 0,1 e 1 g / litro
#Esse valor zerado pode ter sido a imprecisão dos aparelhos de medição
#Vamos trocá-los por 0.1 que é o valor mais provável
Vinhos[vinhosComZero,"citricacid"] <- 0.1Quanto a existência de valores inválidos ou não inexistentes, isto não foi detectado na amostra.
#Verifica se há valores faltantes no dataset
nVinhosComValoresFaltantes <- length(Vinhos[is.na(Vinhos)]) + length(Vinhos[is.nan(as.matrix(Vinhos))])
paste0("Vinhos com valores faltantes = ",nVinhosComValoresFaltantes)## [1] "Vinhos com valores faltantes = 0"Boxplot das variáveis para visualização de outliers
Quando realizamos a quebra pelo tipo de vinho em boxplotes, percebemos as seguintes características:
fixedacidity - O vinho tinto possui potenciais outliers apenas acima da barreira enquanto o branco possui acima e abaixo das barreiras
citricacid - Há mais potenciais outliers para vinho branco e eles aparecem tanto acima como abaixo das barreiras
residual sugar - Para vinho tinto há mais potenciais outliers. Para vinho branco há menos, mas ficam mais distantes da barreira superior
freesulfurdioxide - Há mais potenciais outliers para o vinho branco e se localizam mais distantes da barreira superior.
totalsufurdioxide - Há potenciais outliers tanto abaixo como acima das barreira para vinhos brancos, para tinto apenas acima e mais próximos
density - Para tinto há um número maior de potenciais outliers, tanto abaixo como acima das barreiras, para branco há poucos e alguns bem distantes
sulphates - Para tinto há mais potenciais outliers e mais distantes da barreira superior
alcohol - Há potenciais outliers acima e abaixo das barreiras apenas para vinhos tintos.
Histograma dos atributos por tipo de vinho
Dividiu-se a amostra entre Vinhos Tintos e Vinhos Brancos
A partir dessa divisão, traçaram-se lado a lado os histogramas dessa subdivisão e percebe-se que o histograma é bem diferente para cada atributo e cada tipo de vinho (tinto e branco)
A percepção visual será complementada com os testes T das médias dos atributos numéricos para a comprovação das diferenças.
Teste de hipótese para cada atributo entre os dois tipos de vinho
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo fixedacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 32.423, df = 1848.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 1.376241 1.553458
## sample estimates:
## mean of x mean of y
## 8.319637 6.854788
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo volatileacidity"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 53.059, df = 1938.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.2403544 0.2588044
## sample estimates:
## mean of x mean of y
## 0.5278205 0.2782411
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo citricacid"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -11.216, df = 2055.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.06502621 -0.04567110
## sample estimates:
## mean of x mean of y
## 0.2792308 0.3345794
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo residualsugar"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -48.057, df = 6401, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -4.005513 -3.691539
## sample estimates:
## mean of x mean of y
## 2.538806 6.387332
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo chlorides"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 34.24, df = 1827.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.03930596 0.04408241
## sample estimates:
## mean of x mean of y
## 0.08746654 0.04577236
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo freesulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -54.428, df = 4461.9, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -20.13315 -18.73318
## sample estimates:
## mean of x mean of y
## 15.87492 35.30808
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo totalsulfurdioxide"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -89.872, df = 3477, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -93.89760 -89.88813
## sample estimates:
## mean of x mean of y
## 46.46779 138.36066
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo density"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 43.15, df = 4252.3, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.002600624 0.002848190
## sample estimates:
## mean of x mean of y
## 0.9967467 0.9940223
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo pH"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 27.775, df = 2667.1, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.1141740 0.1315191
## sample estimates:
## mean of x mean of y
## 3.311113 3.188267
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo sulphates"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = 37.056, df = 2091, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.159395 0.177209
## sample estimates:
## mean of x mean of y
## 0.6581488 0.4898469
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo alcohol"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -3.3571, df = 2852.3, p-value = 0.0007979
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.18088842 -0.04749554
## sample estimates:
## mean of x mean of y
## 10.40008 10.51427
##
## [1] "Teste de igualdade das médias entre tintos e brancos para o atributo quality"
##
## Welch Two Sample t-test
##
## data: VinhosTintos[, atr] and VinhosBrancos[, atr]
## t = -10.149, df = 2950.8, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.2886173 -0.1951564
## sample estimates:
## mean of x mean of y
## 5.636023 5.877909Realizados os testes T para as amostras separadas de vinhos tintos e brancos, observam-se os fatos descritos abaixo: * Para cada atributo numérico dos vinhos brancos e tintos realizou-se um teste T * Os testes foram parametrizados com um nível de confiança de 95% * O p-value de cada um dos testes apresentou valores substancialmente menores que 5%.
Deste modo, para o modelo preditivo a ser desenvolvido, a partir deste ponto, iremos separar a amostras entre os dois tipos de vinho (tinto,branco) e prosseguiremos na criação do modelo preditivo da qualidade apenas para os vinhos brancos
Tratatamento dos outliers
## [1] "Potenciais outliers referentes ao atributo fixedacidity"
## [1] "Quantidade de potenciais outliers 119"
## [1] ""
## [1] 9.3 9.1 9.2 9.2 9.2 9.3 9.2 9.8 8.9 9.2 9.2 4.2 9.8 10.3
## [15] 10.2 9.8 9.0 10.0 8.9 8.9 9.2 9.0 10.0 9.0 9.2 9.8 9.0 4.7
## [29] 8.9 4.7 10.7 8.9 9.6 9.2 8.9 8.9 9.0 9.1 9.8 9.2 9.4 9.0
## [43] 9.6 9.0 9.2 9.6 9.3 9.8 9.2 9.0 9.9 4.7 4.4 9.6 8.9 9.8
## [57] 9.9 8.9 9.4 9.2 8.9 10.0 9.0 4.6 9.0 3.8 9.0 9.2 9.0 9.7
## [71] 9.2 9.7 11.8 9.7 14.2 8.9 8.9 9.7 4.7 9.4 9.5 9.4 9.1 9.4
## [85] 9.0 9.0 9.4 9.6 9.0 9.2 10.7 9.8 9.1 10.3 3.9 9.2 4.4 8.9
## [99] 9.4 9.0 9.2 4.4 8.9 4.2 9.5 9.0 9.4 4.7 9.2 9.2 9.1 9.4
## [113] 9.4 4.5 8.9 8.9 9.1 9.2 9.4
## [1] ""
## [1] "Potenciais outliers referentes ao atributo volatileacidity"
## [1] "Quantidade de potenciais outliers 186"
## [1] ""
## [1] 0.580 0.560 0.510 0.520 0.695 0.670 0.550 0.610 0.640 0.710 0.640
## [12] 0.555 0.540 0.570 0.510 0.520 0.660 0.610 0.595 0.520 0.620 0.580
## [23] 0.490 0.530 0.550 0.520 0.590 0.570 0.510 0.490 0.550 0.560 0.540
## [34] 0.590 0.910 0.660 0.510 0.550 0.640 0.690 0.670 0.510 0.490 0.540
## [45] 0.690 0.580 0.555 0.580 0.600 0.545 0.500 0.610 0.670 0.815 0.650
## [56] 0.530 0.540 0.655 0.600 0.520 0.550 0.560 0.670 0.655 0.500 0.520
## [67] 0.680 0.615 0.490 0.560 0.550 0.490 0.930 0.490 0.685 0.520 0.530
## [78] 0.550 0.760 0.640 0.490 0.560 0.600 0.510 0.580 0.640 0.620 1.005
## [89] 0.560 0.965 0.520 0.500 0.520 0.490 0.560 0.540 0.500 0.530 0.520
## [100] 0.640 0.640 0.600 0.530 0.490 0.530 0.695 0.560 0.610 0.500 0.500
## [111] 0.730 0.500 0.510 0.660 0.600 0.670 0.580 0.780 0.680 0.630 0.615
## [122] 0.530 0.615 0.620 0.500 0.570 0.540 0.490 0.550 0.550 0.500 0.530
## [133] 0.550 0.785 0.570 1.100 0.705 0.600 0.850 0.510 0.500 0.600 0.495
## [144] 0.620 0.660 0.750 0.540 0.905 0.490 0.550 0.510 0.655 0.585 0.705
## [155] 0.680 0.580 0.500 0.540 0.595 0.610 0.540 0.500 0.650 0.610 0.615
## [166] 0.740 0.610 0.495 0.550 0.585 0.590 0.760 0.490 0.510 0.695 0.500
## [177] 0.620 0.540 0.550 0.490 0.630 0.590 0.550 0.490 0.560 0.500
## [1] ""
## [1] "Potenciais outliers referentes ao atributo citricacid"
## [1] "Quantidade de potenciais outliers 251"
## [1] ""
## [1] 0.07 1.00 0.74 0.07 0.09 0.62 0.04 0.07 0.06 0.68 0.59 0.04 0.01 0.07
## [15] 0.71 0.74 0.67 0.02 0.04 0.74 1.00 0.61 0.59 0.64 0.74 0.70 0.58 0.62
## [29] 0.66 0.71 0.88 0.68 0.74 0.04 0.64 0.65 0.01 0.67 0.58 0.62 0.62 0.67
## [43] 0.58 0.72 0.91 0.62 0.71 0.05 0.74 0.58 0.74 0.07 0.05 0.74 0.58 0.72
## [57] 0.65 0.01 0.09 0.09 0.06 0.74 0.72 0.79 0.09 0.08 0.72 0.65 0.81 0.66
## [71] 0.66 0.04 0.74 0.65 0.58 0.05 0.61 0.71 0.58 0.71 0.71 0.09 0.73 0.58
## [85] 0.59 0.74 0.74 0.02 0.82 0.66 0.99 0.74 0.73 0.66 1.66 0.58 0.64 0.74
## [99] 0.79 0.58 0.74 0.71 0.04 0.07 1.00 0.01 0.58 0.74 0.65 0.69 0.01 0.64
## [113] 0.67 0.73 0.09 0.60 0.74 0.74 0.74 0.80 0.60 0.60 0.69 0.06 0.01 1.23
## [127] 0.74 0.63 0.82 0.78 0.69 0.58 0.74 0.58 0.78 0.60 0.04 0.61 0.73 0.74
## [141] 0.65 0.74 0.66 0.65 1.00 0.74 0.61 0.02 0.62 0.61 0.08 0.06 0.68 0.02
## [155] 0.07 0.07 0.06 0.62 0.62 0.74 0.69 0.07 0.91 0.02 1.00 0.04 0.70 0.74
## [169] 0.59 0.68 0.09 0.74 0.74 0.05 0.61 0.08 0.68 0.02 0.71 0.61 0.62 0.07
## [183] 0.67 0.63 0.68 0.62 0.74 0.68 0.58 0.07 0.09 0.74 0.74 0.03 0.69 0.58
## [197] 0.60 0.65 0.74 0.81 0.80 0.67 0.58 0.08 0.74 0.62 0.09 0.09 0.04 0.72
## [211] 0.61 0.74 0.74 0.09 0.67 0.74 0.01 0.06 0.60 0.73 0.74 0.04 0.64 0.62
## [225] 0.63 0.58 0.63 0.04 0.58 0.64 0.74 0.07 0.74 0.59 0.61 0.58 0.74 0.03
## [239] 0.66 0.74 0.58 0.71 0.62 0.70 0.59 0.09 0.58 0.86 0.04 0.62 0.05
## [1] ""
## [1] "Potenciais outliers referentes ao atributo residualsugar"
## [1] "Quantidade de potenciais outliers 7"
## [1] ""
## [1] 26.05 31.60 22.60 45.80 31.60 26.05 23.50
## [1] ""
## [1] "Potenciais outliers referentes ao atributo chlorides"
## [1] "Quantidade de potenciais outliers 208"
## [1] ""
## [1] 0.114 0.014 0.074 0.093 0.172 0.171 0.147 0.123 0.083 0.168 0.074
## [12] 0.092 0.075 0.144 0.126 0.115 0.076 0.346 0.076 0.154 0.087 0.096
## [23] 0.160 0.084 0.076 0.169 0.104 0.072 0.093 0.086 0.108 0.009 0.095
## [34] 0.074 0.152 0.212 0.158 0.092 0.079 0.175 0.142 0.077 0.083 0.096
## [45] 0.084 0.185 0.118 0.173 0.170 0.073 0.076 0.167 0.145 0.088 0.201
## [56] 0.117 0.076 0.094 0.200 0.080 0.137 0.168 0.073 0.080 0.105 0.204
## [67] 0.014 0.157 0.150 0.174 0.290 0.076 0.121 0.180 0.152 0.148 0.110
## [78] 0.122 0.084 0.074 0.119 0.133 0.194 0.170 0.094 0.119 0.083 0.098
## [89] 0.102 0.094 0.208 0.099 0.138 0.088 0.117 0.087 0.135 0.176 0.184
## [100] 0.185 0.078 0.142 0.120 0.211 0.157 0.092 0.082 0.086 0.080 0.149
## [111] 0.208 0.119 0.126 0.123 0.156 0.012 0.244 0.076 0.085 0.110 0.074
## [122] 0.239 0.138 0.098 0.110 0.142 0.076 0.072 0.083 0.096 0.121 0.014
## [133] 0.096 0.073 0.147 0.168 0.184 0.117 0.126 0.083 0.074 0.123 0.136
## [144] 0.085 0.137 0.197 0.074 0.075 0.082 0.074 0.094 0.096 0.081 0.108
## [155] 0.079 0.073 0.098 0.112 0.157 0.160 0.079 0.127 0.078 0.201 0.175
## [166] 0.169 0.084 0.123 0.087 0.271 0.089 0.255 0.097 0.096 0.176 0.081
## [177] 0.132 0.079 0.091 0.240 0.217 0.090 0.086 0.127 0.094 0.073 0.086
## [188] 0.076 0.173 0.167 0.179 0.301 0.090 0.209 0.013 0.014 0.197 0.130
## [199] 0.157 0.095 0.085 0.093 0.172 0.186 0.084 0.146 0.080 0.174
## [1] ""
## [1] "Potenciais outliers referentes ao atributo freesulfurdioxide"
## [1] "Quantidade de potenciais outliers 50"
## [1] ""
## [1] 108.0 81.0 85.0 289.0 101.0 128.0 83.0 81.0 98.0 86.0 97.0
## [12] 96.0 86.0 87.0 96.0 87.0 82.5 81.0 122.5 146.5 88.0 82.0
## [23] 81.0 105.0 98.0 98.0 82.0 105.0 81.0 112.0 101.0 83.0 81.0
## [34] 131.0 83.0 108.0 85.0 87.0 95.0 93.0 124.0 138.5 108.0 110.0
## [45] 81.0 118.5 89.0 96.0 87.0 83.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo totalsulfurdioxide"
## [1] "Quantidade de potenciais outliers 19"
## [1] ""
## [1] 440.0 9.0 256.0 260.0 19.0 294.0 307.5 256.0 272.0 259.0 18.0
## [12] 303.0 18.0 313.0 344.0 10.0 366.5 272.0 282.0
## [1] ""
## [1] "Potenciais outliers referentes ao atributo density"
## [1] "Quantidade de potenciais outliers 5"
## [1] ""
## [1] 1.00295 1.01030 1.01398 1.01030 1.00295
## [1] ""
## [1] "Potenciais outliers referentes ao atributo pH"
## [1] "Quantidade de potenciais outliers 75"
## [1] ""
## [1] 3.80 3.59 3.57 3.60 3.64 3.63 3.58 2.79 3.82 2.79 3.68 3.65 3.65 3.66
## [15] 3.58 3.69 3.61 3.63 3.60 3.69 3.74 3.59 3.81 3.66 3.63 3.60 3.66 3.60
## [29] 3.57 3.72 2.80 2.77 3.64 3.57 3.63 3.65 3.63 3.59 3.59 3.66 3.68 2.72
## [43] 3.79 3.74 3.75 3.75 3.62 3.59 3.80 2.74 2.79 3.59 3.60 3.61 3.58 3.58
## [57] 3.60 3.57 3.77 3.57 3.58 3.72 3.76 3.65 3.72 3.76 3.60 3.66 3.70 3.61
## [71] 2.80 3.67 3.77 2.80 3.63
## [1] ""
## [1] "Potenciais outliers referentes ao atributo sulphates"
## [1] "Quantidade de potenciais outliers 124"
## [1] ""
## [1] 0.77 0.78 0.78 0.98 0.78 0.79 0.79 0.79 0.86 0.79 0.77 0.82 0.95 0.80
## [15] 0.77 0.79 0.78 0.90 0.88 0.79 0.78 0.78 0.81 0.78 0.78 0.82 0.97 0.78
## [29] 0.78 0.77 0.83 0.81 0.80 0.77 0.88 0.78 0.90 0.79 1.00 0.96 0.82 0.84
## [43] 0.81 0.88 0.82 0.80 0.77 0.98 0.84 0.78 0.79 0.77 0.82 0.88 0.77 0.82
## [57] 0.82 0.98 0.94 0.87 0.82 0.78 0.81 0.79 0.78 0.92 0.82 0.94 0.88 0.88
## [71] 0.79 0.96 0.96 0.77 1.06 0.83 0.85 1.08 0.81 0.95 0.98 0.78 0.79 0.84
## [85] 0.98 0.92 0.80 0.78 0.79 0.90 0.77 0.79 0.86 0.79 0.77 0.82 0.95 0.85
## [99] 0.79 0.77 0.99 0.77 0.95 0.77 0.82 0.77 0.77 0.78 0.89 0.82 0.78 0.80
## [113] 1.01 0.82 0.88 0.85 0.98 0.78 0.79 0.95 0.84 0.87 0.90 0.90
## [1] ""
## [1] "Potenciais outliers referentes ao atributo quality"
## [1] "Quantidade de potenciais outliers 200"
## [1] ""
## [1] 8 8 8 8 8 9 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 8 3 8 8 8 8 8 8 8 3 8 8 8 8
## [36] 8 3 3 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8
## [71] 8 8 3 8 9 8 8 8 9 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 3 8 8 3 8 8 8 8 8 3
## [106] 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 3 8 8 3
## [141] 8 8 8 8 3 8 8 8 8 3 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 8 9
## [176] 8 3 8 8 8 8 8 8 8 8 8 8 3 3 8 8 8 3 8 8 8 8 3 8 8
## [1] ""Há valores potenciais de outliers em quase todos os atributos dos vinhos brancos, exceto na concentração de alchool que não apresenta outliers
Para verificar se os valores são realmente outliers, sabendo-se que os vinhos são portugueses, utilizou-se os valores de referência do Instituto da Vinha e do Vinho de Portugal, com as informações presentes no link a seguir: http://www.ivv.gov.pt/np4/89/
- Acidez Total >= 3.5 g/L
- Acidez Volátil <= 500 mg/L
- Ácido Cítrico <= 1 g/L
- 1 g/L <= Açúcar Residual <= 32 g/L
- Cloretos <= 1 g/L
- Total Dióxiodo de Enxofre <= 250 mg/L
Extração dos outliers
## [1] "Sumário da qualidade dos vinhos Brancos considerados como outliers "## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.000 5.000 5.000 5.284 6.000 8.000
## [1] "Sumário da qualidade dos vinhos Brancos sem outliers"## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 3.00 5.00 6.00 5.91 6.00 9.00## [1] "Teste T para a média de qualidade entre os vinhos brancos sem outliers e a amostra completa"##
## Welch Two Sample t-test
##
## data: VinhosBrancos$quality and VinhosBrancosSemOut$quality
## t = -1.7793, df = 9533.9, p-value = 0.07523
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -0.067137134 0.003248435
## sample estimates:
## mean of x mean of y
## 5.877909 5.909854Os vinhos brancos selecionados como outliers não possuíam uma distribuição especial em relação à qualidade e não afetavam a média da qualidade dos vinhos. Deste modo, realizou-se um teste T entre os vinhos brancos sem os outliers e a amostra completa, com 95% de confiança e falhou (p-value = 7,5%). Portanto as amostra possuem médias iguais. Por fim, os outliers foram retirados da amostra e do modelo a ser utilizado para predição.
Análise de Correlação das variáveis
## fixedacidity volatileacidity citricacid residualsugar
## fixedacidity 1.0000 -0.0351 0.282 0.079
## volatileacidity -0.0351 1.0000 -0.089 0.072
## citricacid 0.2824 -0.0894 1.000 0.077
## residualsugar 0.0789 0.0724 0.077 1.000
## chlorides 0.0095 0.0461 0.128 0.076
## freesulfurdioxide -0.0559 -0.0715 0.091 0.318
## totalsulfurdioxide 0.0732 0.1110 0.102 0.402
## density 0.2602 -0.0013 0.145 0.836
## pH -0.4122 -0.0541 -0.156 -0.200
## sulphates -0.0217 -0.0405 0.053 -0.052
## alcohol -0.1208 0.0896 -0.092 -0.470
## quality -0.1118 -0.1388 -0.043 -0.119
## chlorides freesulfurdioxide totalsulfurdioxide density
## fixedacidity 0.0095 -0.0559 0.073 0.2602
## volatileacidity 0.0461 -0.0715 0.111 -0.0013
## citricacid 0.1279 0.0914 0.102 0.1449
## residualsugar 0.0763 0.3183 0.402 0.8360
## chlorides 1.0000 0.1178 0.184 0.2501
## freesulfurdioxide 0.1178 1.0000 0.614 0.3188
## totalsulfurdioxide 0.1842 0.6139 1.000 0.5421
## density 0.2501 0.3188 0.542 1.0000
## pH -0.0825 -0.0062 0.010 -0.0959
## sulphates -0.0010 0.0473 0.108 0.0566
## alcohol -0.3629 -0.2662 -0.465 -0.8080
## quality -0.2074 0.0081 -0.181 -0.3261
## pH sulphates alcohol quality
## fixedacidity -0.4122 -0.022 -0.121 -0.1118
## volatileacidity -0.0541 -0.040 0.090 -0.1388
## citricacid -0.1562 0.053 -0.092 -0.0431
## residualsugar -0.1995 -0.052 -0.470 -0.1189
## chlorides -0.0825 -0.001 -0.363 -0.2074
## freesulfurdioxide -0.0062 0.047 -0.266 0.0081
## totalsulfurdioxide 0.0103 0.108 -0.465 -0.1813
## density -0.0959 0.057 -0.808 -0.3261
## pH 1.0000 0.163 0.125 0.1063
## sulphates 0.1627 1.000 -0.019 0.0438
## alcohol 0.1246 -0.019 1.000 0.4409
## quality 0.1063 0.044 0.441 1.0000
Pelos gráficos acima, percebe-se:
- Alta correlação positiva entre a densidade e a concentração residual de açúcar
- Alta correlação positiva entre Total de SO2 e a taxa de SO2 livre
- Alta correlação negativa entre o volume de alcool e a densidade
- Correlação entre a densidade e o Total de SO2
- Correlação negativa entre o álcool e a concentração residual de açúcar
- Correlação entre a qualidade e o álcool
Verificando a correlação
Gráfico de dispersão do vinho branco entre a densidade e o açucar residual
Pelo gráfico, pode-se notar uma tendência linear entre as duas variáveis pelo formato do gráfico. Neste, pode-se perceber que, normalmente, quanto maior a densidade, maior a quantidade de açucar residual
Aqui traçou-se um gráfico para a quantidade residual de açúcar x qualidade para os vinhos brancos já sem os outliers. Percebe-se que os vinhos brancos de maior qualidade possuem uma concentração de açúcar menor que 20 g/L
Aplicando componentes principais
## [1] "Variância acumulada para cada componente "## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.38909993 28.2424994 28.24250
## Dim.2 1.58636636 13.2197197 41.46222
## Dim.3 1.26219318 10.5182765 51.98050
## Dim.4 1.12079756 9.3399797 61.32048
## Dim.5 1.00233483 8.3527902 69.67327
## Dim.6 0.95095122 7.9245935 77.59786
## Dim.7 0.74903989 6.2419991 83.83986
## Dim.8 0.73434715 6.1195596 89.95942
## Dim.9 0.57112284 4.7593570 94.71877
## Dim.10 0.34436192 2.8696826 97.58846
## Dim.11 0.27531840 2.2943200 99.88278
## Dim.12 0.01406673 0.1172227 100.00000## [1] "Percentual que cada componente contribui para explicar a variância "
Analisando-se o PCA do modelo completo sobre vinhos brancos, percebe-se:
- Não há um componente que sozinho contribua com mais do que 29% da variância
- Para conter mais do que 80% da variância há a necessidade de ao menos 7 componentes, o que implicaria em existir ao menos 7 componentes
Verificando os auto-vetores do primeiro de segundo componentes do PCA
Pelo gráfico de contribuição dos atributos em relação ao PCA, temos:
- Percebe-se grupos com contribuições no mesmo quadrante e outros no oposto para cada um dos quadrantes
- fixedacidity,citricacid,chlorides,volatileacidity contribuem no mesmo sentido. Havendo melhor alinhamento entre fixedacidity e citricacid.
- residualsugar,density,totalsulfurdioxide,freesulfurdioxide,sulphates estão no mesmo quadrante. Havendo maior proximidade entre residualsugar e density, entre totalsulfurdioxide e freesulfurdioxide.
- ph,quality estão no mesmo quadrante
- alcohol está isolado no último quadrante, no entanto, está quase alinhado com residualsugar e density.
- No primeiro componente há maior peso para os atributos densidade, açucar residual, SO2, SO2 livre e álcool
- No segundo componente foi dado maior peso ao acidez fixa e pH
A partir dessas proximidades entre os auto vetores, e considerando as correlações, será feita uma segunda verificação do uso do PCA nas variáveis totalsulfurdioxide,freesulfurdioxide, density,residualsugar e alcohol
## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.05891171 61.1782342 61.17823
## Dim.2 1.00870998 20.1741995 81.35243
## Dim.3 0.54765165 10.9530331 92.30547
## Dim.4 0.34022528 6.8045055 99.10997
## Dim.5 0.04450138 0.8900277 100.00000Analisando a tabela acima, nota-se que os dois primeiros componentes já contribuem para mais de 80% da variancia da base. Mediante a constatação, criou-se dois novos atributos pca1 e pca2 correspondendo ao primeiro e segundo componentes do PCA. Por fim, os atributos originais foram excluídos do modelo por serem passíveis de substituição sem grandes prejuízos.
## [1] "Histograma do Primeiro Componente"
## [1] "Histograma do Segundo Componente"
Regressões
# Split em conjuntos de treinamento e teste
set.seed(333)
treinamento <- sample_frac(VinhosBrancosNum, 0.7)
teste <- setdiff(VinhosBrancosNum, treinamento)
# Dados sem a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> treinamento_semPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol, quality) -> teste_semPCA
# Dados com a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> treinamento_comPCA
teste %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality) -> teste_comPCA# Modelo de regressão linear simples
modelo0 <- lm(quality ~ . ,
data=treinamento_comPCA)
modelo1 <- lm(quality ~ . ,
data=treinamento_semPCA)
measures <- function(x) {
L <- list(npar = length(coef(x)),
dfres = df.residual(x),
nobs = length(fitted(x)),
RMSE = summary(x)$sigma,
R2 = summary(x)$r.squared,
R2adj = summary(x)$adj.r.squared,
PRESS = press(x),
logLik = logLik(x),
AIC = AIC(x),
BIC = BIC(x))
unlist(L)
}
modl <- list(m1 = modelo0,m2=modelo1)
round(t(sapply(modl, measures)), 3)## npar dfres nobs RMSE R2 R2adj PRESS logLik AIC BIC
## m1 9 3245 3254 0.794 0.166 0.164 2059.332 -3863.631 7747.262 7808.139
## m2 12 3242 3254 0.741 0.275 0.272 1794.333 -3636.296 7298.593 7377.732# Modelo de regressão linear com o modelo aplicado o PCA
print("Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA")## [1] "Modelo com regressão linear aplicada sobre o modelo com atributos gerados pelo PCA"result <- testa.modelo(modelo=modelo0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Linear com PCA")## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.794633943337489"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Modelo com os dados completos sem transformação via PCA
print("Modelo de regressão linear aplicada sobre o modelo com todos os atributos")## [1] "Modelo de regressão linear aplicada sobre o modelo com todos os atributos"result <- testa.modelo(modelo=modelo1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear Completo")## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747299468844422"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
##### UTILIZANDO FORWARD,BACKWARD OU BOTH
VinhosBrancosStep <- treinamento_semPCA
modelo.base <- lm(quality ~ fixedacidity,
data=VinhosBrancosStep)
modelo.completo <- lm(quality ~ . ,
data=VinhosBrancosStep)
modelo.medio <- lm(quality ~ fixedacidity+volatileacidity+citricacid+chlorides+pH+sulphates,
data=VinhosBrancosStep)
forward<-step(modelo.base,direction="forward")## Start: AIC=-952.82
## quality ~ fixedaciditybackward<-step(modelo.completo,direction="backward")## Start: AIC=-1937.86
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates + totalsulfurdioxide + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - chlorides 1 0.047 1780.7 -1939.8
## - citricacid 1 0.268 1780.9 -1939.4
## - totalsulfurdioxide 1 0.291 1780.9 -1939.3
## <none> 1780.7 -1937.9
## - alcohol 1 7.480 1788.1 -1926.2
## - fixedacidity 1 7.515 1788.2 -1926.2
## - freesulfurdioxide 1 9.352 1790.0 -1922.8
## - sulphates 1 12.070 1792.7 -1917.9
## - pH 1 19.357 1800.0 -1904.7
## - density 1 26.707 1807.4 -1891.4
## - residualsugar 1 40.868 1821.5 -1866.0
## - volatileacidity 1 66.611 1847.3 -1820.3
##
## Step: AIC=-1939.77
## quality ~ fixedacidity + volatileacidity + citricacid + pH +
## sulphates + totalsulfurdioxide + freesulfurdioxide + density +
## residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - citricacid 1 0.244 1780.9 -1941.3
## - totalsulfurdioxide 1 0.282 1781.0 -1941.3
## <none> 1780.7 -1939.8
## - alcohol 1 7.450 1788.2 -1928.2
## - fixedacidity 1 8.073 1788.8 -1927.0
## - freesulfurdioxide 1 9.305 1790.0 -1924.8
## - sulphates 1 12.251 1793.0 -1919.5
## - pH 1 20.328 1801.0 -1904.8
## - density 1 28.081 1808.8 -1890.9
## - residualsugar 1 43.647 1824.3 -1863.0
## - volatileacidity 1 67.510 1848.2 -1820.7
##
## Step: AIC=-1941.33
## quality ~ fixedacidity + volatileacidity + pH + sulphates + totalsulfurdioxide +
## freesulfurdioxide + density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## - totalsulfurdioxide 1 0.289 1781.2 -1942.8
## <none> 1780.9 -1941.3
## - alcohol 1 7.698 1788.6 -1929.3
## - fixedacidity 1 8.407 1789.3 -1928.0
## - freesulfurdioxide 1 9.669 1790.6 -1925.7
## - sulphates 1 12.384 1793.3 -1920.8
## - pH 1 20.088 1801.0 -1906.8
## - density 1 27.840 1808.8 -1892.8
## - residualsugar 1 43.403 1824.3 -1865.0
## - volatileacidity 1 68.509 1849.5 -1820.5
##
## Step: AIC=-1942.8
## quality ~ fixedacidity + volatileacidity + pH + sulphates + freesulfurdioxide +
## density + residualsugar + alcohol
##
## Df Sum of Sq RSS AIC
## <none> 1781.2 -1942.8
## - alcohol 1 7.427 1788.7 -1931.3
## - fixedacidity 1 8.871 1790.1 -1928.6
## - freesulfurdioxide 1 12.063 1793.3 -1922.8
## - sulphates 1 12.339 1793.6 -1922.3
## - pH 1 20.520 1801.8 -1907.5
## - density 1 32.094 1813.3 -1886.7
## - residualsugar 1 47.688 1828.9 -1858.8
## - volatileacidity 1 74.740 1856.0 -1811.0stepwise<-step(modelo.medio,direction="both")## Start: AIC=-1169.81
## quality ~ fixedacidity + volatileacidity + citricacid + chlorides +
## pH + sulphates
##
## Df Sum of Sq RSS AIC
## - citricacid 1 1.174 2262.8 -1170.1
## - sulphates 1 1.302 2262.9 -1169.9
## <none> 2261.6 -1169.8
## - pH 1 3.122 2264.7 -1167.3
## - fixedacidity 1 20.597 2282.2 -1142.3
## - volatileacidity 1 45.937 2307.6 -1106.4
## - chlorides 1 96.729 2358.3 -1035.5
##
## Step: AIC=-1170.12
## quality ~ fixedacidity + volatileacidity + chlorides + pH + sulphates
##
## Df Sum of Sq RSS AIC
## <none> 2262.8 -1170.1
## - sulphates 1 1.479 2264.3 -1170.0
## + citricacid 1 1.174 2261.6 -1169.8
## - pH 1 2.940 2265.7 -1167.9
## - fixedacidity 1 19.423 2282.2 -1144.3
## - volatileacidity 1 47.547 2310.3 -1104.5
## - chlorides 1 95.651 2358.4 -1037.4print("*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****")## [1] "*** Análise dos indicadores para modelos de regressão linear obtidos pelos métodos forward,backward e both ****"modl <- list(m1 = forward,m2=backward,m3=stepwise)
round(t(sapply(modl, measures)), 3)## npar dfres nobs RMSE R2 R2adj PRESS logLik AIC BIC
## m1 2 3252 3254 0.864 0.012 0.012 2428.240 -4138.817 8283.634 8301.897
## m2 9 3245 3254 0.741 0.275 0.273 1792.086 -3636.826 7293.653 7354.529
## m3 6 3248 3254 0.835 0.079 0.077 2272.160 -4026.164 8066.327 8108.941##### TESTE DE PREDIÇÃO DOS MODELOS #######
print("Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos")## [1] "Modelo de regressão linear utilizando a estratégia forward nos vinhos brancos com todos os atributos"result<-testa.modelo(modelo=forward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico="Linear com forward")## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.864954247314014"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
print("Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos")## [1] "Modelo de regressão linear utilizando a estratégia backward nos vinhos brancos com todos os atributos"result<-testa.modelo(modelo=backward, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com backward")## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.747013073135287"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
print("Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos")## [1] "Modelo de regressão linear utilizando a estratégia both nos vinhos brancos com todos os atributos"result<-testa.modelo(modelo=stepwise, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Linear com both")## [1] "Sumário do modelo...."
## [1] "MSE para o modelo---> 0.839878291284835"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
##### Testa contra os piores modelos
VinhosBrancosModelosRuins <- VinhosBrancosNum
#Utiliza como
VinhosBrancosModelosRuins$qualidade.media <- mean(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.media
print("Modelo Ruim - retorna sempre a média ")## [1] "Modelo Ruim - retorna sempre a média "result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - Sempre a média")## [1] "MSE para o modelo---> 0.868162825258606"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"VinhosBrancosModelosRuins$qualidade.max <- max(VinhosBrancosModelosRuins$quality)
valores_preditos <- VinhosBrancosModelosRuins$qualidade.max
print("Modelo Ruim - retorna sempre o máximo ")## [1] "Modelo Ruim - retorna sempre o máximo "result<-testa.modelo(modelo=NULL,valores_observados=VinhosBrancosModelosRuins$quality,
valores_preditos=valores_preditos,tit_grafico = "Modelo Ruim - sempre o máximo")## [1] "MSE para o modelo---> 3.20978361316982"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
library(rpart)
print("Modelo de Árvore de regressão com aplicação de PCA - atributos retirados")## [1] "Modelo de Árvore de regressão com aplicação de PCA - atributos retirados"result<-testa.modelo(modelo=modelo_Valor_tree0, dataset=teste_comPCA, valores_observados=teste_comPCA$quality, tit_grafico = "Árvore de Regressão com PCA", sumario=FALSE)## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 341 obs. of 8 variables:
## ..$ var : Factor w/ 9 levels "<leaf>","chlorides",..: 5 9 2 9 7 8 6 5 7 1 ...
## ..$ n : int [1:341] 3254 2197 1412 1073 560 435 425 157 13 4 ...
## ..$ wt : num [1:341] 3254 2197 1412 1073 560 ...
## ..$ dev : num [1:341] 2456 1369 759 502 218 ...
## ..$ yval : num [1:341] 5.91 5.74 5.56 5.46 5.33 ...
## ..$ complexity: num [1:341] 0.08662 0.04776 0.02123 0.00729 0.0026 ...
## ..$ ncompete : int [1:341] 4 4 4 4 4 4 4 4 4 0 ...
## ..$ nsurrogate: int [1:341] 5 5 5 5 2 0 5 2 3 0 ...
## $ where : Named int [1:3254] 269 88 205 311 36 206 110 14 281 328 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_comPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2)
## .. ..- attr(*, "factors")= int [1:9, 1:8] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:8] 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2)
## .. ..- attr(*, "dataClasses")= Named chr [1:9] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:9] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:128, 1:5] 0.0866 0.0558 0.0478 0.0212 0.0118 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:128] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1304, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1304] "pca1" "chlorides" "pca2" "citricacid" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:8] 475 377 275 254 200 ...
## ..- attr(*, "names")= chr [1:8] "pca1" "pca2" "chlorides" "volatileacidity" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:8] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:8] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.860193041488428"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
library(rpart)
print("Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA")## [1] "Modelo de Árvore de regressão com todos os atributos - sem aplicação de PCA"result<-testa.modelo(modelo=modelo_Valor_tree1, dataset=teste_semPCA, valores_observados=teste_semPCA$quality, tit_grafico = "Árvore de Regressão completa", sumario=FALSE)## [1] "Sumário do modelo...."
## List of 14
## $ frame :'data.frame': 311 obs. of 8 variables:
## ..$ var : Factor w/ 12 levels "<leaf>","alcohol",..: 2 12 2 7 11 1 1 4 10 6 ...
## ..$ n : int [1:311] 3254 2065 1064 837 59 37 22 778 182 121 ...
## ..$ wt : num [1:311] 3254 2065 1064 837 59 ...
## ..$ dev : num [1:311] 2455.6 1189.1 463.4 290.2 22.2 ...
## ..$ yval : num [1:311] 5.91 5.64 5.39 5.32 4.88 ...
## ..$ complexity: num [1:311] 0.17476 0.05444 0.00801 0.00498 0.00171 ...
## ..$ ncompete : int [1:311] 4 4 4 4 4 0 0 4 4 4 ...
## ..$ nsurrogate: int [1:311] 5 5 5 2 5 0 0 5 5 0 ...
## $ where : Named int [1:3254] 236 129 54 223 60 114 81 6 305 284 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ call : language rpart(formula = quality ~ ., data = treinamento_semPCA, cp = 0.001, minsplit = 5, maxdepth = 10)
## $ terms :Classes 'terms', 'formula' language quality ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide + fr| __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:12, 1:11] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:11] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, frees| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:12] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:12] "quality" "fixedacidity" "volatileacidity" "citricacid" ...
## $ cptable : num [1:110, 1:5] 0.1748 0.0544 0.0281 0.0165 0.0112 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:110] "1" "2" "3" "4" ...
## .. ..$ : chr [1:5] "CP" "nsplit" "rel error" "xerror" ...
## $ method : chr "anova"
## $ parms : NULL
## $ control :List of 9
## ..$ minsplit : num 5
## ..$ minbucket : num 2
## ..$ cp : num 0.001
## ..$ maxcompete : int 4
## ..$ maxsurrogate : int 5
## ..$ usesurrogate : int 2
## ..$ surrogatestyle: int 0
## ..$ maxdepth : num 10
## ..$ xval : int 10
## $ functions :List of 2
## ..$ summary:function (yval, dev, wt, ylevel, digits)
## ..$ text :function (yval, dev, wt, ylevel, digits, n, use.n)
## $ numresp : int 1
## $ splits : num [1:1314, 1:5] 3254 3254 3254 3254 3254 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1314] "alcohol" "density" "chlorides" "totalsulfurdioxide" ...
## .. ..$ : chr [1:5] "count" "ncat" "improve" "index" ...
## $ variable.importance: Named num [1:11] 629 503 273 269 259 ...
## ..- attr(*, "names")= chr [1:11] "alcohol" "density" "totalsulfurdioxide" "chlorides" ...
## $ y : Named int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "names")= chr [1:3254] "3070" "556" "6319" "3766" ...
## $ ordered : Named logi [1:11] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:11] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## - attr(*, "xlevels")= Named list()
## - attr(*, "class")= chr "rpart"
## [1] "MSE para o modelo---> 0.830208896967626"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Regressão Logística
treinamento_comPCA %>%
mutate(quality_rel = quality/10) -> treinamento_comPCA_rel
treinamento_comPCA$quality <- NULL
treinamento_semPCA %>%
mutate(quality_rel = quality/10) -> treinamento_semPCA_rel
treinamento_semPCA$quality <- NULL
teste_comPCA %>%
mutate(quality_rel = quality/10) -> teste_comPCA_rel
teste_comPCA$quality <- NULL
teste_semPCA %>%
mutate(quality_rel = quality/10) -> teste_semPCA_rel
teste_semPCA$quality <- NULL
# Regressão Logística com a aplicação do PCA
modelo_logistica0 <- glm(quality_rel ~ . ,
family = binomial(link = 'logit'),
data = treinamento_comPCA_rel)
print("Modelo de Regressão Logística com aplicação de PCA - atributos retirados")## [1] "Modelo de Regressão Logística com aplicação de PCA - atributos retirados"result<-testa.modelo(modelo=modelo_logistica0, dataset=teste_comPCA_rel, valores_observados=teste_comPCA_rel$quality_rel, tit_grafico = "Regressão Logística com PCA", sumario=FALSE)## [1] "Sumário do modelo...."
## List of 30
## $ coefficients : Named num [1:10] -2.190683 0.000932 0.03144 -0.001623 0.0073 ...
## ..- attr(*, "names")= chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ residuals : Named num [1:3254] 0.000116 -0.003817 0.007515 -0.016336 0.00977 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ fitted.values : Named num [1:3254] 0.7 0.701 0.498 0.604 0.498 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ effects : Named num [1:3254] -9.8346 -1.0663 1.5379 -0.0672 1.9127 ...
## ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ R : num [1:10, 1:10] -27.6 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ rank : int 10
## $ qr :List of 5
## ..$ qr : num [1:3254, 1:10] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
## .. .. ..$ : chr [1:10] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## ..$ rank : int 10
## ..$ qraux: num [1:10] 1.02 1.02 1.02 1.02 1.01 ...
## ..$ pivot: int [1:10] 1 2 3 4 5 6 7 8 9 10
## ..$ tol : num 1e-11
## ..- attr(*, "class")= chr "qr"
## $ family :List of 12
## ..$ family : chr "binomial"
## ..$ link : chr "logit"
## ..$ linkfun :function (mu)
## ..$ linkinv :function (eta)
## ..$ variance :function (mu)
## ..$ dev.resids:function (y, mu, wt)
## ..$ aic :function (y, n, mu, wt, dev)
## ..$ mu.eta :function (eta)
## ..$ initialize: expression({ if (NCOL(y) == 1) { if (is.factor(y)) y <- y != levels(y)[1L] n <- rep.int(1, nobs) y[weights =| __truncated__
## ..$ validmu :function (mu)
## ..$ valideta :function (eta)
## ..$ simulate :function (object, nsim)
## ..- attr(*, "class")= chr "family"
## $ linear.predictors: Named num [1:3254] 0.84718 0.85111 -0.00751 0.42177 -0.00977 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ deviance : num 0.436
## $ aic : num 3402
## $ null.deviance : num 104
## $ iter : int 4
## $ weights : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ prior.weights : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ df.residual : int 3244
## $ df.null : int 3253
## $ y : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ converged : logi TRUE
## $ boundary : logi FALSE
## $ model :'data.frame': 3254 obs. of 10 variables:
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ pca1 : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
## ..$ pca2 : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "terms")=Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + quality
## .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. .. ..- attr(*, "intercept")= int 1
## .. .. ..- attr(*, "response")= int 1
## .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ call : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"), data = treinamento_comPCA_rel)
## $ formula :Class 'formula' language quality_rel ~ .
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## $ terms :Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + pca1 + pca2 + quality
## .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. ..- attr(*, "factors")= int [1:10, 1:9] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:9] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:9] 1 1 1 1 1 1 1 1 1
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2, quality)
## .. ..- attr(*, "dataClasses")= Named chr [1:10] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:10] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ data :'data.frame': 3254 obs. of 10 variables:
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity: num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ pca1 : num [1:3254] -2.498 0.162 -2.086 -1.412 1.02 ...
## ..$ pca2 : num [1:3254] 0.232 0.728 -1.559 0.756 0.375 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## $ offset : NULL
## $ control :List of 3
## ..$ epsilon: num 1e-08
## ..$ maxit : num 25
## ..$ trace : logi FALSE
## $ method : chr "glm.fit"
## $ contrasts : NULL
## $ xlevels : Named list()
## - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365047384034817"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
# Regressão Logística sem a aplicação de PCA
modelo_logistica1 <- glm(quality_rel ~ . ,
family = binomial(link = 'logit'),
data = treinamento_semPCA_rel)
print("Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA")## [1] "Modelo de Regressão Logística com todos os atributos - sem aplicação de PCA"result<-testa.modelo(modelo=modelo_logistica1, dataset=teste_semPCA_rel, valores_observados=teste_semPCA_rel$quality_rel, tit_grafico = "Regressão Logística completa", sumario=FALSE)## [1] "Sumário do modelo...."
## List of 30
## $ coefficients : Named num [1:13] -2.421499 0.000672 0.033491 -0.001266 -0.006122 ...
## ..- attr(*, "names")= chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ residuals : Named num [1:3254] 0.000287 -0.005205 0.00676 -0.016403 0.010866 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ fitted.values : Named num [1:3254] 0.7 0.701 0.498 0.604 0.497 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ effects : Named num [1:3254] -9.8346 -1.0664 1.5375 -0.0671 1.9128 ...
## ..- attr(*, "names")= chr [1:3254] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ R : num [1:13, 1:13] -27.6 0 0 0 0 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## $ rank : int 13
## $ qr :List of 5
## ..$ qr : num [1:3254, 1:13] -27.5993 0.0166 0.0181 0.0177 0.0181 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:3254] "1" "2" "3" "4" ...
## .. .. ..$ : chr [1:13] "(Intercept)" "fixedacidity" "volatileacidity" "citricacid" ...
## ..$ rank : int 13
## ..$ qraux: num [1:13] 1.02 1.02 1.02 1.02 1.01 ...
## ..$ pivot: int [1:13] 1 2 3 4 5 6 7 8 9 10 ...
## ..$ tol : num 1e-11
## ..- attr(*, "class")= chr "qr"
## $ family :List of 12
## ..$ family : chr "binomial"
## ..$ link : chr "logit"
## ..$ linkfun :function (mu)
## ..$ linkinv :function (eta)
## ..$ variance :function (mu)
## ..$ dev.resids:function (y, mu, wt)
## ..$ aic :function (y, n, mu, wt, dev)
## ..$ mu.eta :function (eta)
## ..$ initialize: expression({ if (NCOL(y) == 1) { if (is.factor(y)) y <- y != levels(y)[1L] n <- rep.int(1, nobs) y[weights =| __truncated__
## ..$ validmu :function (mu)
## ..$ valideta :function (eta)
## ..$ simulate :function (object, nsim)
## ..- attr(*, "class")= chr "family"
## $ linear.predictors: Named num [1:3254] 0.84701 0.8525 -0.00676 0.42184 -0.01087 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ deviance : num 0.435
## $ aic : num 3409
## $ null.deviance : num 104
## $ iter : int 4
## $ weights : Named num [1:3254] 0.21 0.21 0.25 0.239 0.25 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ prior.weights : Named num [1:3254] 1 1 1 1 1 1 1 1 1 1 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ df.residual : int 3241
## $ df.null : int 3253
## $ y : Named num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..- attr(*, "names")= chr [1:3254] "1" "2" "3" "4" ...
## $ converged : logi TRUE
## $ boundary : logi FALSE
## $ model :'data.frame': 3254 obs. of 13 variables:
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
## ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
## ..$ density : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
## ..$ residualsugar : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
## ..$ alcohol : num [1:3254] 12 10 10.4 11.5 10.6 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..- attr(*, "terms")=Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide | __truncated__ ...
## .. .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
## .. .. ..- attr(*, "intercept")= int 1
## .. .. ..- attr(*, "response")= int 1
## .. .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
## .. .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ call : language glm(formula = quality_rel ~ ., family = binomial(link = "logit"), data = treinamento_semPCA_rel)
## $ formula :Class 'formula' language quality_rel ~ .
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## $ terms :Classes 'terms', 'formula' language quality_rel ~ fixedacidity + volatileacidity + citricacid + chlorides + pH + sulphates + totalsulfurdioxide | __truncated__ ...
## .. ..- attr(*, "variables")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. ..- attr(*, "factors")= int [1:13, 1:12] 0 1 0 0 0 0 0 0 0 0 ...
## .. .. ..- attr(*, "dimnames")=List of 2
## .. .. .. ..$ : chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## .. .. .. ..$ : chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "term.labels")= chr [1:12] "fixedacidity" "volatileacidity" "citricacid" "chlorides" ...
## .. ..- attr(*, "order")= int [1:12] 1 1 1 1 1 1 1 1 1 1 ...
## .. ..- attr(*, "intercept")= int 1
## .. ..- attr(*, "response")= int 1
## .. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
## .. ..- attr(*, "predvars")= language list(quality_rel, fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide, f| __truncated__ ...
## .. ..- attr(*, "dataClasses")= Named chr [1:13] "numeric" "numeric" "numeric" "numeric" ...
## .. .. ..- attr(*, "names")= chr [1:13] "quality_rel" "fixedacidity" "volatileacidity" "citricacid" ...
## $ data :'data.frame': 3254 obs. of 13 variables:
## ..$ fixedacidity : num [1:3254] 6.8 6 8.2 8.4 6.2 9.7 6.1 7.1 6.4 6.1 ...
## ..$ volatileacidity : num [1:3254] 0.17 0.24 0.37 0.27 0.345 0.24 0.32 0.47 0.32 0.27 ...
## ..$ citricacid : num [1:3254] 0.35 0.27 0.27 0.3 0.27 0.49 0.25 0.24 0.25 0.32 ...
## ..$ chlorides : num [1:3254] 0.04 0.048 0.028 0.037 0.056 0.032 0.034 0.044 0.055 0.034 ...
## ..$ pH : num [1:3254] 2.91 3.64 2.97 2.89 3.31 2.85 3.47 3.21 3.27 3.36 ...
## ..$ sulphates : num [1:3254] 0.57 0.54 0.48 0.3 0.56 0.54 0.5 0.56 0.5 0.4 ...
## ..$ totalsulfurdioxide: num [1:3254] 84 170 59 129 187 18 136 77 138 110 ...
## ..$ freesulfurdioxide : num [1:3254] 29 40 10 36 38 3 37 11 28 24 ...
## ..$ density : num [1:3254] 0.99 0.994 0.992 0.991 0.995 ...
## ..$ residualsugar : num [1:3254] 1.8 1.9 1.7 2.2 10.1 4.9 1.7 6 5 1.1 ...
## ..$ alcohol : num [1:3254] 12 10 10.4 11.5 10.6 ...
## ..$ quality : int [1:3254] 7 7 5 6 5 6 7 5 8 6 ...
## ..$ quality_rel : num [1:3254] 0.7 0.7 0.5 0.6 0.5 0.6 0.7 0.5 0.8 0.6 ...
## $ offset : NULL
## $ control :List of 3
## ..$ epsilon: num 1e-08
## ..$ maxit : num 25
## ..$ trace : logi FALSE
## $ method : chr "glm.fit"
## $ contrasts : NULL
## $ xlevels : Named list()
## - attr(*, "class")= chr [1:2] "glm" "lm"
## [1] "MSE para o modelo---> 0.365071067344587"
## [1] "Erro médio em relação a média para o modelo---> 0.868162825258606"
Algoritmo não supervisionado
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, totalsulfurdioxide,
freesulfurdioxide, density, residualsugar, alcohol) -> NS_treinamento_semPCA
# Dados com a aplicação do PCA
treinamento %>%
select(fixedacidity, volatileacidity, citricacid, chlorides, pH, sulphates, pca1, pca2) -> NS_treinamento_comPCA
kmeans_semPCA <- kmeans(NS_treinamento_semPCA, 7)
kmeans_comPCA <- kmeans(NS_treinamento_comPCA, 7)
print("Quantidade de amostras por qualidade")## [1] "Quantidade de amostras por qualidade"table(treinamento$quality)##
## 3 4 5 6 7 8 9
## 8 85 947 1482 609 119 4print("")## [1] ""print("Quantidade de amostras por cluster sem PCA")## [1] "Quantidade de amostras por cluster sem PCA"kmeans_semPCA$size## [1] 494 771 455 257 649 259 369print("")## [1] ""print("Quantidade de amostras por cluster com PCA")## [1] "Quantidade de amostras por cluster com PCA"kmeans_comPCA$size## [1] 662 502 420 475 352 462 381print("")## [1] ""